home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gwu / read.c < prev    next >
C/C++ Source or Header  |  1996-01-30  |  25KB  |  810 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #define GEN
  11.  
  12. #include "hdr.h"
  13. #include "libhdr.h"
  14. #include "vars.h"
  15. #include "segment.h"
  16. #include "gvars.h"
  17. #include "slot.h"
  18. #include "ifile.h"
  19. #include "axqrp.h"
  20. #include "axqwp.h"
  21. #include "libwp.h"
  22. #include "gutilp.h"
  23. #include "gmiscp.h"
  24. #include "gmainp.h"
  25. #include "libfp.h"
  26. #include "librp.h"
  27. #include "setp.h"
  28. #include "libp.h"
  29. #include "miscp.h"
  30. #include "readp.h"
  31.  
  32. static void get_local_ref_maps(IFILE *, int);
  33. static void put_local_ref_maps(IFILE *, int);
  34. static void relocate_slots_a();
  35. static void relocate_slots_b();
  36. static void overwrite_stub_name(char *);
  37.  
  38. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  39. extern IFILE *AXQFILE, *LIBFILE, *AISFILE, *STUBFILE;
  40.  
  41. static Tuple code_slots_syms, data_slots_syms;
  42.  
  43. /* Input/Output of compiler files */
  44.  
  45. int load_unit(char *unit, int tree_is_needed)                    /*;load_unit*/
  46. {
  47.     /*
  48.      * Retrieves the symbol table of the given unit and puts its information
  49.      * into the compilation maps.
  50.      * An AXQ may be read from the library if the unit has not yet been
  51.      * loaded. If the file cannot be opened, or the unit is not found, an
  52.      * error message is printed.
  53.      * BEWARE: the loaded AXQ may contain an unit with the same name as the
  54.      * current one, that must not be loaded, as its symbol table would
  55.      * override the current one.
  56.      */
  57.  
  58.     char    *fname;
  59.     int        file_retrieved;
  60.     Symbol    unit_unam;
  61.     Tuple    decmaps, decscopes, s_info;
  62.     Unitdecl    ud;
  63.  
  64.     fname = lib_unit_get(unit);
  65. #ifdef TRACE
  66.     if (debug_flag) gen_trace(strjoin("load_unit ", unit));
  67. #endif
  68.     if (fname == (char *)0) {
  69.         user_error(strjoin(formatted_name(unit), " not present in library"));
  70.         return FALSE;
  71.     }
  72.     else if (in_aisunits_read(unit)) {
  73.         file_retrieved = TRUE;
  74.     }
  75.     else {
  76.         file_retrieved = 
  77.           (read_ais(fname, FALSE, unit, 0, tree_is_needed) != (char *)0);
  78.  
  79.         if (is_subunit(unit)) read_stub(lib_unit_get(unit), unit, "st2");
  80. #ifdef TBSL
  81.         if (is_subunit(unit)) {
  82.             /* If the subunit  has been  compiled, its  stub environment 
  83.                 * overrides the one appearing in the axq of the parent unit.
  84.              */
  85.             (for [n, env] in axqt) STUB_ENV(n) : = env; 
  86.             end ;
  87.         }
  88.         else {
  89.             STUB_ENV +: = axqt;
  90.         }
  91. #endif
  92.     }
  93.  
  94.     if (file_retrieved && (ud = unit_decl_get(unit)) != (Unitdecl)0) {
  95.         /* [unit_unam, s_info, decls] = UNIT_DECL(unit); */
  96.         unit_unam = ud->ud_unam;
  97.         s_info = ud->ud_symbols;
  98.         decscopes = ud->ud_decscopes;
  99.         decmaps = ud->ud_decmaps;
  100.         /* TBSL does the info from decscopes and decmaps need to be restored 
  101.          * or is the info restored by symtab_restore since declared info is 
  102.          * stored with the symbols.
  103.          * DECLARED  += decls; 
  104.          * SYMBTABQ restore 
  105.          */
  106.         symtab_restore(s_info);
  107.         return TRUE;
  108.     }
  109.     else {
  110.         user_error(strjoin("Cannot retrieve unit ", formatted_name(unit)));
  111.         user_info(strjoin(" from file ", fname));
  112.         return FALSE;
  113.     }
  114. }
  115.  
  116.  
  117. void load_library(Axq axq)                                    /*;load_library*/
  118. {
  119.     /*
  120.      * retrieve information from LIBFILE
  121.      * Called only not newlib.
  122.      */
  123.  
  124.     int        comp_status, si, i, j, n, m, unumber, nodes, symbols, cur_level;
  125.     int        parent, unit_count;
  126.     Tuple    stubtup, tup;
  127.     char    *parent_name, *uname, *aisname, *tmp_str, *compdate;
  128.     Set        precedes;
  129.     int        n_code_slots, n_data_slots, n_exception_slots;
  130.     long    cde_pos; /* offset for start of slot info */
  131.     IFILE    *ifile;
  132.  
  133.     ifile = LIBFILE;
  134.     /* library already opened */
  135.     unit_count = getnum(ifile, "lib-unit-count");
  136.     n = getnum(ifile, "lib-n");
  137.     empty_unit_slots = getnum(ifile, "lib-empty-slots");
  138.     tmp_str = getstr(ifile, "lib-tmp-str");
  139.     unit_number_expand(n);
  140.     for (i = 1; i <= unit_count; i++) {
  141.         struct unit *pUnit;
  142.         uname = getstr(ifile, "lib-unit-name");
  143.         unumber = getnum(ifile, "lib-unit-number");
  144.         aisname = getstr(ifile, "lib-ais-name");
  145.         compdate = getstr(ifile, "comp-date");
  146.         symbols = getnum(ifile, "lib-symbols");
  147.         nodes = getnum(ifile, "lib-nodes");
  148.         pUnit = pUnits[unumber];
  149.         pUnit->name = strjoin(uname, "");
  150.         pUnit->isMain = getnum(ifile, "lib-is-main");
  151.         pUnit->libInfo.fname = strjoin(aisname, "");
  152.         pUnit->libInfo.compDate = compdate;
  153.         comp_status = getnum(ifile, "lib-status");
  154.         pUnit->libInfo.obsolete = (comp_status) ? "ok" : "$D$";
  155.         pUnit->libUnit = (comp_status) ? strjoin(uname, "") : "$D$";
  156.         pUnit->aisInfo.numberSymbols = symbols;
  157.         pUnit->treInfo.nodeCount = nodes;
  158.         pUnit->treInfo.tableAllocated = (char *) tup_new(0);
  159.     }
  160.     n = getnum(ifile, "lib-n");
  161.     for (i = 1; i <= n; i++) {
  162.         uname = getstr(ifile, "lib-unit-name");
  163.         aisname = getstr(ifile, "lib-ais-name");
  164.         lib_stub_put(uname, aisname);
  165.         parent = getnum(ifile, "lib-parent");
  166.         if (parent == 0) parent_name = " ";
  167.         else parent_name = pUnits[parent]->name;
  168.         stub_parent_put(uname, parent_name);
  169.         cur_level = getnum(ifile, "lib-cur-level");
  170.         current_level_put(uname, cur_level);
  171.         si = stub_numbered(uname);
  172.         stubtup = (Tuple) stub_info[si];
  173.         m = getnum(ifile, "stub-file-size");
  174.         tup = tup_new(m);
  175.         for (j = 1; j <= m; j++)
  176.             tup[j] = (char *) getnum(ifile, "stub-files");
  177.         stubtup[4] = (char *) tup;
  178.     }
  179.     n = getnum(ifile, "precedes-map-size");
  180.     PRECEDES_MAP = tup_new(n);
  181.     for (i = 1; i <= n; i += 2) {
  182.         PRECEDES_MAP[i] = (char *) getnum(ifile, "precedes-map-ent");
  183.         m = getnum(ifile, "precedes-map-set-size");
  184.         precedes = set_new(m);
  185.         for (j = 1; j <= m; j++) {
  186.             precedes = set_with(precedes,
  187.               (char *) getnum(ifile, "precedes-map-ent"));
  188.         }
  189.         PRECEDES_MAP[i+1] = (char *) precedes;
  190.     }
  191.     n = getnum(ifile, "compilation_table_size");
  192.     compilation_table = tup_new(n);
  193.     for (i = 1; i <= n; i++)
  194.         compilation_table[i] = (char *) getnum(ifile, "compilation-table-ent");
  195.     /* late_instances */
  196.     n = getnum(ifile, "late-instances-size");
  197.     late_instances = tup_new(n);
  198.     for (i = 1; i <= n; i++)
  199.         late_instances[i] = getstr(ifile, "late-instances-str");
  200.     n = getnum(ifile, "interfaced-procedures-size");
  201.     interfaced_procedures = tup_new(n);
  202.     for (i = 1; i <= n; i += 2) {
  203.         interfaced_procedures[i] =
  204.           (char *) getnum(ifile, "interfaced-procedures-num");
  205.         interfaced_procedures[i+1]= getstr(ifile, "interfaced-procedures-str");
  206.     }
  207.     interface_counter = getnum(ifile, "interface-counter");
  208.     n = getnum(ifile, "units-size");
  209.     for (i = 1; i <= n; i++) {
  210.         pUnits[i]->libInfo.currCodeSeg =
  211.           (char *) getnum(ifile, "current-code-seg");
  212.     }
  213.     n = getnum(ifile, "units-size");
  214.     /* read local_reference_map for each unit (tuple of symbols and offsets) */
  215.     get_local_ref_maps(LIBFILE, n);
  216.     cde_pos = get_cde_slots(LIBFILE, axq);
  217.     /* Now set CODE_SLOTS, DATA_SLOTS and EXCEPTION_SLOTS from axq */
  218.     n_code_slots = axq->axq_code_slots_dim -1;
  219.     n_data_slots = axq->axq_data_slots_dim - 1;
  220.     n_exception_slots = axq->axq_exception_slots_dim - 1;
  221.     CODE_SLOTS = tup_new(n_code_slots);
  222.     for (i = 1; i <= n_code_slots; i++) {
  223.         CODE_SLOTS[i] = (char *) axq->axq_code_slots[i];
  224.     }
  225.     DATA_SLOTS = tup_new(n_data_slots);
  226.     for (i = 1; i <= n_data_slots; i++) {
  227.         DATA_SLOTS[i] = (char *) axq->axq_data_slots[i];
  228.     }
  229.     EXCEPTION_SLOTS = tup_new(n_exception_slots);
  230.     for (i = 1; i <= n_exception_slots; i++) {
  231.         EXCEPTION_SLOTS[i] = (char *) axq->axq_exception_slots[i];
  232.     }
  233.     /* could free axq_data_slots, etc., but keep for now */
  234.     /* read out LIB_STUB map (always empty for now) */
  235.     ifclose(LIBFILE);
  236.     return;
  237. }
  238.  
  239. void store_axq(IFILE *file, int unit_num)                        /*;store_axq*/
  240. {
  241.     /* Writes the AXQ file of compiled units (symmetrical to LOAD_AIS) */
  242.  
  243.     int        si, i, n, symbols, slots_ind, nsegs;
  244.     long    begpos;
  245.     Tuple    u_slots, symtup, tup;
  246.     Symbol    sym;
  247.     Segment    seg;
  248.     Fortup    ft1;
  249.     Forset    fs1;
  250.     char    *uname;
  251.     Stubenv    ev;
  252.     IFILE    *ofile;
  253.  
  254. #ifdef TRACE
  255.     if (debug_flag) gen_trace_string("STORE_AXQ: ", pUnits[unit_num]->name);
  256. #endif
  257.  
  258.     /* In order to make the sequence of symbols written out dense (consecutive)
  259.      * without holes, the new symbols which are needed externally, namely 
  260.      * GENERATED_OBJECTS have their seq numbers renumbed before being written
  261.      * out. This new ordering begins right after the sequence number of the last
  262.      * symbol read in from the semantic phase.
  263.      */
  264.     pUnits[unit_num]->libInfo.compDate = (char *)greentime(0);
  265.     n = (GENERATED_OBJECTS == (Tuple)0) ? 0 : tup_size(GENERATED_OBJECTS);
  266.     symbols = pUnits[unit_num]->aisInfo.numberSymbols;
  267.     relocate_slots_a();
  268.     for (i = 1; i <= n; i++) {
  269.         sym = (Symbol) GENERATED_OBJECTS[i];
  270.         S_SEQ(sym) = symbols + i;
  271.         seq_symbol[symbols + i] = (char *) sym;
  272.     }
  273.     seq_symbol_n = symbols + n;
  274.     relocate_slots_b();
  275.     AISFILE = AXQFILE;
  276.     begpos = write_ais(unit_num);
  277.     ofile = AXQFILE;
  278.  
  279.     if (n > 0) {
  280.         symtup = (Tuple)pUnits[unit_num]->aisInfo.symbols;
  281.         symtup = tup_exp(symtup, symbols + n);
  282.         for (i = 1; i <= n; i++) 
  283.             symtup[i+symbols] = (char *) GENERATED_OBJECTS[i];
  284.         pUnits[unit_num]->aisInfo.symbols = (char *) symtup;
  285.     }
  286.  
  287.  
  288.     u_slots = unit_slots_get(unit_num);
  289.     /* put out data slots info */
  290.     for (slots_ind = 1; slots_ind <= 4; slots_ind += 3) {
  291.         tup = (Tuple) u_slots[slots_ind];
  292.         nsegs  = 0; /* first count number of defined segments */
  293.         FORTUP(i = (int), tup , ft1)
  294.             seg = segment_map_get(DATA_SEGMENT_MAP, i);
  295.             if (seg != (Segment)0)
  296.                 nsegs++;
  297.         ENDFORTUP(ft1);
  298.         putnum(ofile, "number-segments", nsegs);
  299.         FORTUP(i = (int), tup , ft1)
  300.             seg = segment_map_get(DATA_SEGMENT_MAP, i);
  301.             if (seg != (Segment)0) {
  302.                 putnum(ofile, "segment-number", i);
  303.                 segment_write(AXQFILE, seg);
  304.             }
  305.         ENDFORTUP(ft1);
  306.     }
  307.     /* put out code slots info */
  308.     for (slots_ind = 2; slots_ind <= 5; slots_ind += 3) {
  309.         nsegs = 0;
  310.         FORTUP(i = (int), (Tuple) u_slots[slots_ind], ft1)
  311.             seg = segment_map_get(CODE_SEGMENT_MAP, i);
  312.             if (seg != (Segment)0)
  313.                 nsegs++;
  314.         ENDFORTUP(ft1);
  315.         putnum(ofile, "number-segments", nsegs);
  316.         FORTUP(i = (int), (Tuple) u_slots[slots_ind], ft1)
  317.             seg = segment_map_get(CODE_SEGMENT_MAP, i);
  318.             if (seg != (Segment)0) {
  319.                 putnum(ofile, "slot-number", i);
  320.                 segment_write(AXQFILE, seg);
  321.             }
  322.         ENDFORTUP(ft1);
  323.     }
  324.  
  325.     write_end(ofile, begpos);
  326.     uname = pUnits[unit_num]->name;
  327.     if (is_subunit(uname) &&!is_generic(uname)) {
  328.         si = stub_numbered(uname);
  329.         tup = (Tuple) stub_info[si];
  330.         ev = (Stubenv)tup[2];
  331.         update_stub(ev);
  332.         if (streq(lib_stub_get(uname), AISFILENAME)) overwrite_stub_name(uname);
  333.         write_stub(ev, uname, "st2");
  334.         /* lib_stub_put(uname, AISFILENAME); */
  335.     }
  336.     FORSET(si = (int), stubs_to_write, fs1);
  337.         tup = (Tuple)stub_info[si];
  338.         ev = (Stubenv)tup[2];
  339.         write_stub(ev, lib_stub[si], "st2");
  340.     ENDFORSET(fs1);
  341.     stubs_to_write = set_new(0);
  342. }
  343.  
  344. static void get_local_ref_maps(IFILE *ifile, int units)    /*;get_local_ref_map*/
  345. {
  346.     int        unit, defined, i, off, n;
  347.     Symbol    sym;
  348.     Tuple    local_ref_map;
  349.  
  350.     for (unit = 1; unit <= units; unit++) {
  351.         /* ignore empty ref maps (predef units) and obselete units */
  352.         defined = getnum(ifile, "local-ref-map-defined");
  353.         if (!defined) continue;
  354.         n = getnum(ifile, "local-ref-map-size");
  355.         local_ref_map = tup_new(n);
  356.         pUnits[unit]->libInfo.localRefMap = (char *) local_ref_map;
  357.         for (i = 1; i <= n; i += 2) {
  358.             sym = getsymref(ifile, "local-ref-map-sym");
  359.             local_ref_map[i] = (char *) sym;
  360.             off = getnum(ifile, "local-ref-map-off");
  361.             local_ref_map[i+1] = (char *) off;
  362.         }
  363.     }
  364. }
  365.  
  366. static void put_local_ref_maps(IFILE *ofile, int units)    /*;put_local_ref_map*/
  367. {
  368.     int        unit, i, off, n, symbols;
  369.     Symbol    sym;
  370.     Tuple    local_ref_map;
  371.  
  372.     for (unit = 1; unit <= units; unit++) {
  373.         struct unit *pUnit = pUnits[unit];
  374.         local_ref_map = (Tuple) pUnit->libInfo.localRefMap;
  375.         n = tup_size(local_ref_map);
  376.         /* ignore empty ref maps (predef units) and obselete units */
  377.         if (streq(pUnit->libInfo.obsolete, "ok") && n != 0) {
  378.             putnum(ofile, "local-ref-map-defined", 1);
  379.         }
  380.         else {
  381.             putnum(ofile, "local-ref-map-defined", 0);
  382.             continue;
  383.         }
  384.         symbols = pUnit->aisInfo.numberSymbols;
  385.         putnum(ofile, "local-ref-map-size", n);
  386.         for (i = 1; i <= n; i += 2) {
  387.             /* if the sequence num of the symbol is greater than the number of
  388.                 * symbols it is a case of a generated symbol which is not in
  389.              * generated objects. Ignore for now.
  390.              */
  391.             sym = (Symbol) local_ref_map[i];
  392.             if (sym == (Symbol)0 || (S_UNIT(sym)==unit && S_SEQ(sym) >symbols)){
  393.                 putnum(ofile, "ignore", 0);
  394.                 putnum(ofile, "ignore", 0);
  395.                 putnum(ofile, "ignore", 0);
  396.                 continue;
  397.             }
  398.             off = (int) local_ref_map[i+1];
  399.             putsymref(ofile, "local-ref-map-sym", sym);
  400.             putnum(ofile, "local-ref-map-off", off);
  401.         }
  402.     }
  403. }
  404.  
  405. void write_glib()                                            /*;write_glib*/
  406. {
  407.     int        i, j, n, m, nodes, symbols;
  408.     int        unit_count = 0;
  409.     Tuple    stubtup, tup;
  410.     Set        precedes;
  411.     Forset    fs1;
  412.     IFILE    *ofile;
  413.     extern    char *lib_name;
  414.     char    *t_name, *l_name;
  415.  
  416.     n  = unit_numbers; /* number of units */
  417.     l_name = libset(lib_name);
  418.     ofile = ifopen(LIBFILENAME, "", "w", 0);
  419.     t_name = libset(l_name);
  420.     LIBFILE = ofile;
  421.     for (i = 1; i <= n; i++) {
  422.         if (!streq(pUnits[i]->libInfo.fname, "0") || compiling_predef)
  423.             unit_count++;
  424.     }
  425.     putnum(ofile, "lib-unit-count", unit_count);
  426.     putnum(ofile, "lib-n", n);
  427.     putnum(ofile, "lib-empty-unit-slots", empty_unit_slots);
  428.     putstr(ofile, "lib-aisname", AISFILENAME);
  429.     for (i = 1; i <= n; i++) {
  430.         struct unit *pUnit =  pUnits[i];
  431.         if (compiling_predef) { /* trace for predef build */
  432.             nodes = pUnit->treInfo.nodeCount;
  433.             symbols = pUnit->aisInfo.numberSymbols;
  434.                         /* The first 14 units are predefined by the language */
  435.             if (i <= 14) {
  436.                 if (!streq(pUnit->name, predef_unit_name(i))) {
  437.                     chaos("predef unit name error");
  438.                 }
  439.             }
  440.         }
  441.         if (streq(pUnit->libInfo.fname, "0") && !compiling_predef) continue;
  442.         putstr(ofile, "unit-name", pUnit->name);
  443.         putnum(ofile, "unit-number", i);
  444.         putstr(ofile, "libtup-1", pUnit->libInfo.fname);
  445.         putstr(ofile, "unit-date", pUnit->libInfo.compDate);
  446.         if (streq(pUnit->libInfo.obsolete, "$D$")) {
  447.             putnum(ofile, "unit-symbols", 0);
  448.             putnum(ofile, "unit-nodes", 0);
  449.             putnum(ofile, "unit-is-main", 0);
  450.             putnum(ofile, "unit-comp-status", 0);
  451.             continue;
  452.         }
  453.         putnum(ofile, "unit-symbols", pUnit->aisInfo.numberSymbols);
  454.         putnum(ofile, "unit-nodes", pUnit->treInfo.nodeCount);
  455.         putnum(ofile, "unit-is-main", pUnit->isMain);
  456.         putnum(ofile, "unit-comp-status", 1);
  457.     }
  458.     /* write out lib_stub info */
  459.     unit_count = 0;
  460.     n = tup_size(lib_stub);
  461.     for (i = 1; i <= n; i++) if (!streq(lib_stub[i], "$D$")) unit_count++;
  462.     putnum(ofile, "stub-unit-count", unit_count);
  463.     for (i = 1; i <= n; i++) {
  464.         if (streq(lib_stub[i], "$D$")) continue;
  465.         stubtup = (Tuple) stub_info[i];
  466.         putstr(ofile, "stub-libstub", lib_stub[i]);
  467.         putstr(ofile, "stub-stubtup", stubtup[1]);
  468.         putnum(ofile, "stub-parent", (int)stubtup[5]);
  469.         putnum(ofile, "stub-cur-level", (int)stubtup[3]);
  470.         tup = (Tuple) stubtup[4];
  471.         m = tup_size(tup);
  472.         putnum(ofile, "stub-file-size", m);
  473.         for (j = 1; j <= m; j++) {
  474.             putnum(ofile, "stub-files", (int)tup[j]);
  475.         }
  476.     }
  477.     n = tup_size(PRECEDES_MAP);
  478.     putnum(ofile, "precedes-map-size", n);
  479.     for (i = 1; i <= n; i += 2) {
  480.         putnum(ofile, "precedes-map-ent", (int)PRECEDES_MAP[i]);
  481.         precedes = (Set) PRECEDES_MAP[i+1];
  482.         m = set_size(precedes);
  483.         putnum(ofile, "precedes-map-set-size", m);
  484.         FORSET(m = (int), precedes, fs1);
  485.             putnum(ofile, "precedes-map-ent", m);
  486.         ENDFORSET(fs1);
  487.     }
  488.     n = tup_size(compilation_table);
  489.     putnum(ofile, "compilation-table-size", n);
  490.     /* print compilation table (tuple of unit names) */
  491.     for (i = 1; i <= n; i++) {
  492.         putnum(ofile, "compilation-table-ent", (int)compilation_table[i]);
  493.     }
  494.     n = tup_size(late_instances);
  495.     putnum(ofile, "late-instances-size", n);
  496.     /* print late_instances (tuple of unit names) */
  497.     for (i = 1; i <= n; i++) {
  498.         putstr(ofile, "late-instances-ent", late_instances[i]);
  499.     }
  500.     n = tup_size(interfaced_procedures);
  501.     putnum(ofile, "interfaced-procedures-size", n);
  502.     for (i = 1; i <= n; i += 2) {
  503.         putnum(ofile, "interfaced-procedures-num",
  504.           (int) interfaced_procedures[i]);
  505.         putstr(ofile, "interfaced-procedures-str", interfaced_procedures[i+1]);
  506.     }
  507.     putnum(ofile, "interface-counter", interface_counter);
  508.     n = unit_numbers;
  509.     putnum(ofile, "units-size", n);
  510.     for (i = 1; i <= n; i++) {
  511.         putnum(ofile, "current-code-seg", (int) pUnits[i]->libInfo.currCodeSeg);
  512.     }
  513.     putnum(ofile, "unit-size", unit_numbers);
  514.     put_local_ref_maps(LIBFILE, unit_numbers);
  515.     put_cde_slots(LIBFILE, 0);/* write slots info and close file */
  516.     LIBFILE = (IFILE *) 0;
  517. }
  518.  
  519. static void relocate_slots_a()                            /*;relocate_slots_a*/
  520. {
  521.     /* This procedure is the first in the possible relocation of sequence
  522.      * numbers which appear in the Slot field. 
  523.      */
  524.     int     i, n;
  525.     Slot     slot;
  526.  
  527.     n = tup_size(CODE_SLOTS);
  528.     code_slots_syms = tup_new(n);
  529.     for (i = 1; i <= n; i++) {
  530.         slot = (Slot) CODE_SLOTS[i];
  531.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now)
  532.             code_slots_syms[i] = (char *) seq_symbol[slot->slot_seq];
  533.     }
  534.     n = tup_size(DATA_SLOTS);
  535.     data_slots_syms = tup_new(n);
  536.     for (i = 1; i <= n; i++) {
  537.         slot = (Slot) DATA_SLOTS[i];
  538.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now)
  539.             data_slots_syms[i] = (char *) seq_symbol[slot->slot_seq];
  540.     }
  541. }
  542.  
  543. static void relocate_slots_b()                            /*;relocate_slots_b*/
  544. {
  545.     int     i, n;
  546.     Slot     slot;
  547.     Symbol     sym;
  548.  
  549.     n  = tup_size(CODE_SLOTS);
  550.     for (i = 1; i <= n; i++) {
  551.         slot = (Slot) CODE_SLOTS[i];
  552.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now) {
  553.             sym = (Symbol) code_slots_syms[i];
  554.             slot->slot_seq = S_SEQ(sym);
  555.         }
  556.     }
  557.     n = tup_size(DATA_SLOTS);
  558.     for (i = 1; i <= n; i++) {
  559.         slot = (Slot) DATA_SLOTS[i];
  560.         if (slot != (Slot)0 && slot->slot_unit == unit_number_now) {
  561.             sym = (Symbol) data_slots_syms[i];
  562.             slot->slot_seq = S_SEQ(sym);
  563.         }
  564.     }
  565.     tup_free(data_slots_syms);
  566.     tup_free(code_slots_syms);
  567. }
  568.  
  569. void update_stub(Stubenv ev)                                /*;update_stub*/
  570. {
  571.     Tuple   tup;
  572.     Symbol  ev_sym, sym;
  573.     int       i, n;
  574.  
  575.     /* update the SEGMENT and OFFSET fields for procedure symbols since the
  576.      * code generator might have updated their values in a previous unit.
  577.      * Also update  the associated_symbols fields for procedure and packages.
  578.      * Note: this is necessary since for procedures a copy of the symbol is
  579.      * made when the symbol is read into ev_open_decls and therefore some fields
  580.      * might not have been updated when the global symbol accessed by getsymptr
  581.      * is updated.
  582.      * TBSL this might have to be done for packages, and functions.
  583.      */
  584.     tup = ev->ev_open_decls;
  585.     n = tup_size(tup);
  586.     for (i = 1; i <= n; i++) {
  587.         ev_sym = (Symbol) tup[i];
  588.         if (NATURE(ev_sym) == na_procedure) {
  589.             sym = getsymptr(S_SEQ(ev_sym), S_UNIT(ev_sym));
  590.             S_SEGMENT(ev_sym) = S_SEGMENT(sym);
  591.             S_OFFSET(ev_sym) = S_OFFSET(sym);
  592.         }
  593.         if (NATURE(ev_sym) == na_package || NATURE(ev_sym) == na_procedure) {
  594.             sym = getsymptr(S_SEQ(ev_sym), S_UNIT(ev_sym));
  595.             if (ASSOCIATED_SYMBOLS(sym) != (Tuple)0)
  596.                 ASSOCIATED_SYMBOLS(ev_sym) = ASSOCIATED_SYMBOLS(sym);
  597.         }
  598.     }
  599. }
  600.  
  601. static void overwrite_stub_name(char *uname)            /*;overwrite_stub_name*/
  602. {
  603.     /* If a stub and its proper body are in the same compilation, this 
  604.      * procedure is called. Normally the code generator write the st2 file
  605.      * after the unit constaining the stub is processed. If the proper body
  606.      * then appears later in the compilation, we must go back to where the 
  607.      * info for the stub was written and change its name so that only the
  608.      * second appearance (proper body) is recognized.
  609.      */
  610.     long  str_pos, rec;
  611.     char  *funame;
  612.     IFILE *ifile;
  613.  
  614.     ifclose(STUBFILE);
  615.     STUBFILE = ifopen(AISFILENAME, "st2", "r+", 0);
  616.     ifile = STUBFILE;
  617.     for (rec = read_init(ifile); rec != 0; rec = read_next(ifile, rec)) {
  618.         str_pos = iftell(ifile);
  619.         funame = getstr(ifile, "stub-name");
  620.         if (!streq(uname, funame)) continue;
  621.         ifseek(ifile, "seek to string", str_pos, 0);
  622.         funame[0] = '$';
  623.         putstr(ifile, "stub-name", funame);
  624.         break;
  625.     }
  626.     ifseek(ifile, "seek to end", 0L, 2);
  627.     ifile->fh_mode = 'w';
  628. }
  629.  
  630. void overwrite_unit_name(char *uname)                /*;overwrite_unit_name*/
  631. {
  632.     /* If a compilation unit appears more than once in the same compilation,
  633.      * this procedure is called.  The code for the first occurrence must be
  634.      * disabled. This is done by going back to where the info for the unit was
  635.      * written and change its name so that only the second appearance is
  636.      * recognized.
  637.      */
  638.     long  str_pos, rec;
  639.     char  *funame;
  640.     IFILE *ifile;
  641.  
  642.     ifclose(AXQFILE);
  643.     AXQFILE = ifopen(AISFILENAME, "axq", "r+", 0);
  644.     ifile = AXQFILE;
  645.     for (rec = read_init(ifile); rec != 0; rec = read_next(ifile, rec)) {
  646.         str_pos = iftell(ifile);
  647.         funame = getstr(ifile, "unit-name");
  648.         if (!streq(uname, funame)) continue;
  649.         ifseek(ifile, "seek to string", str_pos, 0);
  650.         funame[0] = '$';
  651.         putstr(ifile, "unit-name", funame);
  652.         break;
  653.     }
  654.     ifseek(ifile, "seek to end", 0L, 2);
  655.     ifile->fh_mode = 'w';
  656. }
  657.  
  658. int read_stub_short(char *fname, char *uname, char *ext)    /*;read_stub_short*/
  659. {
  660.     long    rec;
  661.     Stubenv    ev;
  662.     int        i, j, k, n, m, si;
  663.     char    *funame;
  664.     Tuple    stubtup, tup, tup2, tup3;
  665.     int        ci, cn;
  666.     Tuple    cent, ctup, cntup;
  667.     Symbol    sym;
  668.     int        retrieved = FALSE;
  669.     IFILE    *ifile;
  670.  
  671.     /* This is a modifed version of read_stub which only reads enough
  672.      * information from the stubfile so that it can be rewritten. Notably it
  673.      * reads just the symbol references and not the full symbol definitions.
  674.      * It is called from gen_stub.
  675.       */
  676.  
  677.     /* open so do not fail if no file */
  678.     ifile = ifopen(fname, ext, "r", 1);
  679.     if (ifile == (IFILE *)0) { /* if not stub file */
  680.         return retrieved;
  681.     }
  682.     for (rec = read_init(ifile); rec != 0; rec = read_next(ifile, rec)) {
  683.         funame = getstr(ifile, "stub-name");
  684.         if (uname != (char *)0  && !streq(uname, funame)) continue;
  685.         si = stub_number(funame);
  686.         if (uname == (char *)0) lib_stub_put(funame, fname);
  687.         ev = stubenv_new();
  688.         stubtup = (Tuple) stub_info[si];
  689.         stubtup[2] = (char *) ev;
  690.         n = getnum(ifile, "scope-stack-size");
  691.         tup = tup_new(n);
  692.         for (i = 1; i <= n; i++) {
  693.             tup2 = tup_new(4);
  694.             tup2[1] = (char *) getsymref(ifile, "scope-stack-symref");
  695.             for (j = 2; j <= 4; j++) {
  696.                 m = getnum(ifile, "scope-stack-m");
  697.                 tup3 = tup_new(m);
  698.                 for (k = 1; k <= m; k++)
  699.                     tup3[k] = (char *) getsymref(ifile, "scope-stack-m-symref");
  700.  
  701.                 tup2[j] = (char *) tup3;
  702.             }
  703.             tup[i] = (char *) tup2;
  704.         }
  705.         ev->ev_scope_st = tup;
  706.         ev->ev_unit_unam = getsymref(ifile, "ev-unit-name-symref");
  707.         ev->ev_decmap = getdcl(ifile);
  708.  
  709.         /* unit_nodes */
  710.         n = getnum(ifile, "ev-nodes-size");
  711.         tup = tup_new(n);
  712.         for (i = 1; i <= n; i++) {
  713.             tup[i] = (char *) getnodref(ifile, "ev-nodes-nodref");
  714.         }
  715.         ev->ev_nodes = tup;
  716.  
  717.         /* context */
  718.         n = getnum(ifile, "stub-context-size");
  719.         if (n>0) {
  720.             n -= 1; /* true tuple size */
  721.             ctup = tup_new(n);
  722.             for (i = 1; i <= n; i++) {
  723.                 cent = (Tuple) tup_new(2);
  724.                 cent[1] = (char *) getnum(ifile, "stub-cent-1");
  725.                 cn = getnum(ifile, "stub-cent-2-size"); 
  726.                 cntup = tup_new(cn);
  727.                 for (ci = 1; ci <= cn; ci++) {
  728.                     cntup[ci] = getstr(ifile, "stub-cent-2-str");
  729.                 }
  730.                 cent[2] = (char *) cntup;
  731.                 ctup[i] = (char *) cent;
  732.             }
  733.             ev->ev_context =  ctup;
  734.         }
  735.         /* tuple of symbol table pointers */
  736.         n = getnum(ifile, "ev-open-decls-size");
  737.         if (n > 0) {
  738.             n -= 1; /* true tuple size */
  739.             tup = tup_new(n);
  740.             for (i = 1; i <= n; i++) {
  741.                 sym = getsymref(ifile, "ev-open-decls-sym");
  742.                 tup[i] = (char *) sym;
  743.             }
  744.             ev->ev_open_decls = tup;
  745.         }
  746.         ev->ev_relay_set = tup_new(0);
  747.         ev->ev_dangling_relay_set = tup_new(0);
  748.         retrieved = TRUE;
  749.         if (uname != (char *)0)  break;
  750.     }
  751.     ifclose(ifile);
  752.     return retrieved;
  753. }
  754.  
  755. void retrieve_generic_body(Symbol sym)                /*;retrieve_generic_body*/
  756. {
  757.     Symbol    scope_of_sym;
  758.     char    *uname, *fname;
  759.  
  760.     scope_of_sym = SCOPE_OF(sym);
  761.     if (scope_of_sym == symbol_standard0) return;
  762.     while (scope_of_sym != symbol_standard0) {
  763.         sym = scope_of_sym;
  764.         scope_of_sym = SCOPE_OF(sym);
  765.     }
  766.     if (NATURE(sym) == na_package_spec) {
  767.         uname = strjoin("bo", ORIG_NAME(sym));
  768.         fname = lib_unit_get(uname);
  769.         if (fname == (char *)0) { /* body not present in library */
  770.             return;
  771.         }
  772.         /* unit read already or predefined unit which is not necessary to read*/
  773.         else if (in_aisunits_read(uname) || streq(fname, "0")) {
  774.             return;
  775.         }
  776.         /* accessing unit within the same files */
  777.         else if (streq(fname, AISFILENAME)) {
  778.             return;
  779.         }
  780.         read_ais(fname, FALSE, uname, 0, FALSE);
  781.     }
  782. }
  783.  
  784. void collect_stub_node_units(int si)                /*;collect_stub_node_units*/
  785. {
  786.     /*
  787.      * Collect the unit numbers which potentially have nodes in them that are
  788.      * referenced by the open_decls (symbol table) of the .st1 file for the
  789.      * stub "si". This information will be used to retrieve the tree nodes when
  790.      * the proper body is seen.
  791.      */
  792.  
  793.     Stubenv ev;
  794.     Tuple   tup, units_tup, stubtup;
  795.     Symbol  sym;
  796.     int        i, n;
  797.  
  798.     stubtup = (Tuple) stub_info[si];
  799.     ev = (Stubenv) stubtup[2];
  800.     tup = ev->ev_open_decls;
  801.     n = tup_size(tup);
  802.     units_tup = tup_new(0);
  803.     for (i = 1; i <= n; i++) {
  804.         sym = (Symbol) tup[i];
  805.         if (!tup_mem((char *)S_UNIT(sym), units_tup))
  806.             units_tup = tup_with(units_tup, (char *)S_UNIT(sym));
  807.     }
  808.     stubtup[4] = (char *) units_tup;
  809. }
  810.